home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tptc16.zip / TEST.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  3KB  |  113 lines
  1.  
  2. (*
  3.  * This program demonstrates some weaknesses in TPC 1.4 and TPC 1.5.  Unless
  4.  * otherwise noted, all failed translations are in 1.4 and corrected in 1.5.
  5.  *
  6.  *)
  7.  
  8.  
  9. program Test;
  10.  
  11.  
  12. var
  13.    vector     : Integer absolute $0000:$03c4;
  14.                         (* absolute variables not translated in tpc 1.5 *)
  15.  
  16.    Ch         : Char;
  17.    IbmAt      : Boolean;
  18.    Control    : Boolean;
  19.  
  20. type
  21.   Longstring = string[255];
  22.  
  23.   Lookup = Array[1..7,0..1] of integer;
  24.                         (* multi-dimension array declarations not translated
  25.                            in tpc 1.5 *)
  26.  
  27. const
  28.   tab  : Lookup = { this goes haywire here      }
  29.                      ((10,824), (9,842), (9,858), (9,874),
  30.                       (10,890), (9,908), (9,924));
  31.  
  32.  
  33.  
  34. procedure InvVid(m:  longstring);       {added}
  35. begin
  36.    writeln(m);
  37. end;
  38.  
  39.  
  40. procedure call_a;                       {added}
  41. begin
  42. end;
  43.  
  44. procedure call_b(L     : Integer;
  45.                        table : Lookup);
  46.  
  47. const
  48.    seg_addr = $0040;                    {constants added}
  49.    filter_ptr = $200;
  50.    Vert = '|';
  51.    Dbl = '==';
  52.  
  53. begin
  54.   Write(Memw[seg_addr : Filter_Ptr] + 1); GotoXY(4,4);
  55.   GotoXY(4,11);
  56.  
  57. { put this next line in blows up -- }
  58.           InvVid(Vert+' Retrieve '+Dbl+' Save '+Dbl+
  59.                      ' Combine '+Dbl+' Xtract '+Dbl+' Erase '+
  60.                      Dbl+' List '+Dbl+' Import '+Dbl+
  61.                      ' Directory '+ Vert);
  62. end;
  63.  
  64.  
  65. {---------------------------------------------------------------------}
  66. {                                                                     }
  67. {           THIS IS WHERE THE PROGRAM STARTS EXECUTING                }
  68. {                                                                     }
  69. {---------------------------------------------------------------------}
  70.  
  71. procedure main_block;   {renamed; 'main' is reserved in C}
  72.  
  73. begin
  74.  if Mem[$ffff:$0e] = $FC then
  75.    begin
  76.      IbmAt := True;
  77.    end;
  78.  
  79.  Repeat
  80.  
  81.  
  82.    if IbmAt then
  83.      begin
  84.        Control := True;
  85.      end
  86.    else
  87. {  call_a;      if you comment this out, blows up }
  88.  
  89. {   end; what's this?  turbo won't take it either }
  90.  
  91.    case Ch of
  92.  
  93.  
  94.       '1'..'8':     call_a;     { fails to put in cases from 2 to 7     }
  95.       'Z' :         call_a;
  96.       'z' :        begin end;                { do nothing     }
  97.        else
  98.            { Do Nothing }
  99. {  call_a;              if you comment this out, blows up        }
  100.       end;
  101.  
  102.  Until (Ch = Chr(13))  OR  (Ch = 'Z');
  103. end;
  104.  
  105.  
  106.  
  107. begin
  108.    (* main block *)
  109.    main_block;
  110.  
  111. end.
  112.  
  113.